module PLPTP1( 
	Traductor,
	cambiarAE,
	acumularAes,
	intercambiarConsecutivos,
	espejarEntreAs,
	aplicando,
	fAst, gAst,
	salidaAes,
	salidaPosible,
	comp,
	identidad,
	sin0Sueltos
) where

-- Todo lo bueno del espiritu Haskell, que vendria a ser
-- mas o menos como el espiritu santo pero ejecutable.
--
-- 									Agustin Gutierrez

import Prelude

-- El traductor se representa por un conjunto de estados "q",
	--   - una funcion de transicion (primer parametro),
	--   - una funcion de output (segundo parametro) y
	--   - un estado inicial.
type Traductor q = (q -> Char -> q, q -> Char -> String, q)

-- Traductor identidad
identidad :: Traductor ()
identidad = (const, (\_ c -> [c]), ())

-- Traductor que cambia las "a"s por "e"s y viceversa.
cambiarAE :: Traductor ()
cambiarAE = (const, g, ())
		where
			g :: () -> Char -> String
			g () 'a' = "e"
			g () 'e' = "a"
			g ()  x  = [x]

-- Traductor que intercambia caracteres consecutivos.
intercambiarConsecutivos :: Traductor (Maybe Char)
intercambiarConsecutivos = (agarrar,outputear,Nothing)
	where
		agarrar :: (Maybe Char) -> Char -> (Maybe Char)
		agarrar Nothing c = Just c
		agarrar (Just _) _ = Nothing
		
		outputear :: (Maybe Char) -> Char -> String
		outputear Nothing c = ""
		outputear (Just c) d = [d,c]

-- Traductor que sea la identidad, salvo que nunca genera
-- salida output de las "a"s y, cuando aparece una "z",
-- muestra la "z" y luego todas las "a"s que se acumularon
-- juntas.
acumularAes :: Traductor Int
acumularAes = (f, g, 0)
		where
			f :: Int -> Char -> Int
			f x 'a' = x + 1
			f x 'z' = 0
			f x  c  = x
			--
			g :: Int -> Char -> String
			g x 'z' = 'z':(replicate x 'a')
			g x 'a' = [ ]
			g x  c  = [c]

-- Traductor que de vuelta (ie. espeje) todo lo que esta
-- entre dos "a"s consecutivas.
espejarEntreAs :: Traductor String
espejarEntreAs = (f, g, "")
		where
			f :: String -> Char -> String
			f s 'a' = ""
			f s c = c:s

			g :: String -> Char -> String
			g s 'a' = s ++ "a"	
			g s c = []

-- Calcular la clausura de Kleene de la funcion de
-- transicion pasada como parametro
-- (version recursiva explicita).
fAst' :: (q -> Char -> q) -> q -> String -> q
fAst' f q0    ""  = q0
fAst' f q0 (c:cs) = fAst' f (f q0 c) cs

-- Calcular la clausura de Kleene de la funcion de
-- transicion pasada como parametro
-- (version con esquemas de recursion).
fAst :: (q -> Char -> q) -> q -> String -> q
fAst f = foldl f

-- Calcular la clausura de Kleene de la funcion de
-- salida pasada como parametro junto con la funcion
-- de transicion pasada como parametro
-- (version recursiva explicita).
gAst' :: (q -> Char -> q) -> (q -> Char -> String) -> q -> String -> String
gAst' f g q0    ""  = ""
gAst' f g q0 (c:cs) = (g q0 c) ++ gAst' f g (f q0 c) cs

-- Calcular la clausura de Kleene de la funcion de salida
-- pasada como parametro junto con la funcion de
-- transicion pasada como parametro
-- (version con esquemas de recursion).
gAst :: (q -> Char -> q) -> (q -> Char -> String) -> q -> String -> String
gAst f g q0 l = 
	foldr (\x rec -> (\q -> ((g q x) ++ (rec $ f q x))))
		(\q -> "") l $ q0

-- Dado un traductor, retornar la funcion String -> String
-- que resulta al aplicarlo a cualquier entrada
aplicando :: Traductor q -> String -> String
aplicando (f, g, q) = gAst f g q

-- Dados dos traductores, dar un traductor tal que la
-- funcion String -> String que denota el resultado, sea
-- justo la composicion de las funciones de cada
-- uno de los parametros.
comp :: Traductor qq1 -> Traductor qq2 -> Traductor (qq1, qq2)
comp u v = (fc,gc,(q0u,q0v))
				where
					(fu,gu,q0u) = u
					(fv,gv,q0v) = v
						
					fc (a,b) x = (fAst fu a $ gv b x,fv b x)
					gc (a,b) x = gAst fu gu a $ gv b x

-- Dado un traductor, dar la cadena infinita que resulta de
-- procesar una lista infinita de "a"s (si se pide
-- "take n (salidaAes t)" no puede procesar infinitamente
-- para ningun "n")
salidaAes :: Traductor q -> String
salidaAes t = aplicando t ['a','a'..]

-- Decidir si es posible que el traductor dado de la salida
-- dada como segundo parametro
salidaPosible :: Traductor q -> String -> Bool
salidaPosible t esperado = any 	(\x -> esperado == (aplicando t x)) 
								(todasLasCadenasAcotadas esperado)

--Devuelve la lista que consiste en agregar cada digito posible 
--al principio de s
agregarDigitos :: String -> [String]
agregarDigitos s = map (:s) ['0'..'9']

--Devuelve todas las cadenas de digitos cuya longitud es menor 
--o igual que la del string pasado
todasLasCadenasAcotadas:: String -> [String]
todasLasCadenasAcotadas = foldr (\_ r -> r ++ (concatMap agregarDigitos r)) 
						  [""]

-- Un traductor para hacer testing, transforma digitos en 0
-- Devuelve cosas de la forma ((1..9)*(00*0)*)*0*
sin0Sueltos::Traductor Bool
sin0Sueltos = (f, g, True)
		where
			f:: Bool -> Char -> Bool
			f b '0' = not b
			f b _ = b

			g :: Bool -> Char -> String
			g False _ = "0"
			g True c = [c]
